home *** CD-ROM | disk | FTP | other *** search
/ PC Open 107 / PC Open 107 CD 1.bin / CD1 / INTERNET / COPIA SITI / Getleft / getleft-setup-notcl.exe / {app} / scripts / CuadroSpin.tcl < prev    next >
Encoding:
Text File  |  2004-03-06  |  7.9 KB  |  236 lines
  1. ###############################################################################
  2. ###############################################################################
  3. ##                                CuadroSpin.tcl
  4. ###############################################################################
  5. ###############################################################################
  6. ## Creates a SpinBox. Next version of Tcl/Tk will have its own SpinBox widget,
  7. ## but up until then we need this.
  8. ###############################################################################
  9. ###############################################################################
  10. ## (c) 1997-2001 Eliseo Vergara, AndrΘs Garcφa Garcφa. fandom@retemail.es
  11. ## As with the combobox I don't know the whole story of this widget, Eliseo
  12. ## pass it to me at college, but he may not have done it completely himself.
  13. ##
  14. ## You may distribute the contents of this file under the terms of the LGPL v2
  15. ###############################################################################
  16. ###############################################################################
  17.  
  18. namespace eval CuadroSpin {
  19.  
  20. ###############################################################################
  21. # Before defining the CuadroSpin we are going to define the shape of the arrow
  22. # points 'IncrValue' and 'DecValue'.
  23. # If you would like to change the shape yourself you only have to save
  24. # the numbers inside the '{}' in a file with the 'XBM' extension and
  25. # edit it with a drawing program.
  26. ###############################################################################
  27.  
  28. set DecValue {
  29.     #define abajo_width  9
  30.     #define abajo_height 6
  31.     static unsigned char abajo_bits[] = {
  32.         0x00, 0x00, 0xfe, 0x00,
  33.         0x7c, 0x00, 0x38, 0x00,
  34.         0x10, 0x00, 0x00, 0x00
  35.     };
  36. }
  37.  
  38. image create bitmap DecValue -data [set DecValue]
  39. unset DecValue
  40.  
  41. set IncrValue {
  42.     #define arriba_width  9
  43.     #define arriba_height 6
  44.     static unsigned char arriba_bits[] = {
  45.         0x00, 0x00, 0x10, 0x00,
  46.         0x38, 0x00, 0x7c, 0x00,
  47.         0xfe, 0x00, 0x00, 0x00
  48.     };
  49. }
  50. image create bitmap IncrValue -data [set IncrValue]
  51. unset IncrValue
  52.  
  53. ##############################################################################
  54. # EnableSpin
  55. #    Enables or disables a spinbox.
  56. #
  57. # Parameter
  58. #    spinPath: The path to the CuadroSpin.
  59. #    which:    "normal" or "disable"
  60. ##############################################################################
  61. proc EnableSpin {spinPath which} {
  62.     variable csArgs
  63.  
  64.     $spinPath.e       configure -state $which
  65.     if {$which=="disable"} {
  66.         $spinPath.e   configure -bg $csArgs(-disbg)
  67.         $spinPath.e   configure -fg $csArgs(-disfg)
  68.     } else {
  69.         $spinPath.e   configure -bg $csArgs(-bg)
  70.         $spinPath.e   configure -fg $csArgs(-fg)
  71.     }
  72.     $spinPath.bg.incr configure -state $which
  73.     $spinPath.bg.dec  configure -state $which
  74.  
  75.     return
  76. }
  77.  
  78. ##############################################################################
  79. # IncrSpin
  80. #    Increments or decrements the content of the spinBox by one.
  81. #
  82. # Parameter
  83. #    spinPath: The path to the CuadroSpin.
  84. #    max:      Maximun value allowed for the CuadroSpin
  85. #    min:      Minumun value allowed for the CuadroSpin.
  86. ##############################################################################
  87. proc IncrSpin {spinPath min max value} {
  88.     variable CuadroSpins
  89.  
  90.     set varName  [$spinPath.e cget -textvariable]
  91.     upvar #0 $varName entryValue
  92.  
  93.     if {![regexp {^[-0-9]+$} $entryValue]} {
  94.         return
  95.     }
  96.  
  97.     if {$value>0} {
  98.         set tmp [expr $entryValue+$CuadroSpins($spinPath,incr)]
  99.         if {$tmp<$max} {
  100.             set entryValue  $tmp
  101.         } else {
  102.             set entryValue  $max
  103.         }
  104.     } else {
  105.         set tmp [expr $entryValue-$CuadroSpins($spinPath,incr)]
  106.         if {$tmp>$min} {
  107.             set entryValue  $tmp
  108.         } else {
  109.             set entryValue  $min
  110.         }
  111.     }
  112.     return
  113. }    
  114.  
  115. ##############################################################################
  116. # CheckBounds
  117. #    Checks that the content of the CuadroSpin is within the established bounds
  118. #    if it isn't it sets it to the nearest limit.
  119. #
  120. # Parameter
  121. #    spinPath: The path to the CuadroSpin.
  122. #    max:      Maximun value allowed for the CuadroSpin
  123. #    min:      Minumun value allowed for the CuadroSpin.
  124. ##############################################################################
  125. proc CheckBounds {spinPath min max} {
  126.     variable CuadroSpins
  127.  
  128.     set varName  [$spinPath.e cget -textvariable]
  129.     upvar #0 $varName entryValue
  130.  
  131.     if {![regexp {^[-0-9]+$} $entryValue]} {
  132.         return
  133.     }
  134.  
  135.     if {$entryValue>$max} {
  136.         set entryValue $max
  137.     } elseif {$entryValue<$min} {
  138.         set entryValue $min
  139.     }
  140.     return
  141. }
  142.  
  143. ###############################################################################
  144. # ParseArguments
  145. #    Gets the optional parameters passed to the SpinBox into the
  146. #    namespace variable 'csArgs', the rest get the default values.
  147. ###############################################################################
  148. proc ParseArguments {spinPath parameters} {
  149.     variable csArgs
  150.  
  151.     upvar $parameters args
  152.  
  153.     set csArgs(-width)         5
  154.     set csArgs(-incr)          1
  155.     set csArgs(-min)           0
  156.     set csArgs(-max)           100
  157.     set csArgs(-default)       0
  158.     set csArgs(-bg)            white
  159.     set csArgs(-fg)            black
  160.     set csArgs(-disbg)         grey
  161.     set csArgs(-disfg)         black
  162.     set csArgs(-textvariable)  ::CuadroSpin::CuadroSpins($spinPath)
  163.  
  164.     array set csArgs $args
  165.  
  166.     return
  167. }
  168.  
  169. ##############################################################################
  170. # CuadroSpin
  171. #    This is the procedure to create the CuadroSpin.
  172. #
  173. # Parameter
  174. #    spinPath: The path to the CuadroSpin.
  175. #    default:  Default value for the CuadroSpin.
  176. #    max:      Maximun value allowed for the CuadroSpin
  177. #    min:      Minumun value allowed for the CuadroSpin.
  178. #    width:    The width of the entry in the spinbox, defaults to 5
  179. #    incr:     The increment or decrement to apply to the value, defaults
  180. #              to '1'
  181. #    textvariable: As usual.
  182. #
  183. # Returns
  184. #    The path to the CuadroSpin.
  185. ##############################################################################
  186. proc CuadroSpin {spinPath args} {
  187.     variable CuadroSpins
  188.     variable csArgs
  189.  
  190.     ParseArguments $spinPath args
  191.     set CuadroSpins($spinPath)      $csArgs(-default)
  192.     set CuadroSpins($spinPath,incr) $csArgs(-incr)
  193.  
  194.     frame $spinPath -relief sunken -bd 1
  195.  
  196.     entry $spinPath.e -bd 1 -justify right -relief sunken               \
  197.             -width $csArgs(-width) -bg $csArgs(-bg) -fg $csArgs(-fg)
  198.  
  199.     $spinPath.e configure -textvariable $csArgs(-textvariable)
  200.     if {![info exists $csArgs(-textvariable)]} {
  201.         set $csArgs(-textvariable) $csArgs(-default)
  202.     }
  203.  
  204.     frame  $spinPath.bg -bg $csArgs(-bg)
  205.     button $spinPath.bg.incr -relief raised -image IncrValue            \
  206.             -height 2 -width 4                                          \
  207.             -command "CuadroSpin::IncrSpin $spinPath $csArgs(-min)      \
  208.             $csArgs(-max)  1"
  209.     button $spinPath.bg.dec -relief raised  -image DecValue             \
  210.             -height 2 -width 4                                          \
  211.             -command "CuadroSpin::IncrSpin $spinPath $csArgs(-min)      \
  212.             $csArgs(-max) -1"
  213.     pack $spinPath.e -side left   -fill both
  214.     pack $spinPath.bg
  215.     pack $spinPath.bg.incr $spinPath.bg.dec
  216.  
  217.     bind $spinPath.e <FocusIn>  "$spinPath.e selection range 0 end"
  218.     bind $spinPath.e <FocusOut> "CuadroSpin::CheckBounds $spinPath      \
  219.             $csArgs(-min) $csArgs(-max)"
  220.  
  221.     return $spinPath
  222. }
  223.  
  224. }
  225.  
  226. #################################EXAMPLE########################################
  227. #
  228. #wm title . "CuadroSpin"
  229. #focus .
  230. #
  231. #CuadroSpin::CuadroSpin .cuadroSpin1 10 5 30
  232. #CuadroSpin::CuadroSpin .cuadroSpin2 20 0 40
  233. #
  234. #pack .cuadroSpin1 .cuadroSpin2 -side top
  235. ################################################################################
  236.